home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 1999 August / SGI Freeware 1999 August.iso / dist / fw_xemacs.idb / usr / freeware / lib / xemacs-20.4 / lisp / w3 / mule-sysdp.el.z / mule-sysdp.el
Encoding:
Text File  |  1998-05-21  |  6.1 KB  |  198 lines
  1. ;;; mule-sysdp.el --- consolidate MULE-version dependencies in one file.
  2.  
  3. ;; Copyright (c) 1996, 1997 William Perry
  4.  
  5. ;; Author: William Perry <wmperry@cs.indiana.edu>
  6. ;; Keywords: lisp, tools
  7.  
  8. ;; The purpose of this file is to eliminate the cruftiness that
  9. ;; would otherwise be required of packages that want to run on multiple
  10. ;; versions of Emacs with and without Mule support.
  11.  
  12. (require 'cl)
  13.  
  14. (defconst mule-sysdep-version (if (featurep 'mule)
  15.                   (cond
  16.                    ((string-match "XEmacs" emacs-version)
  17.                     'xemacs)
  18.                    ((and
  19.                      (boundp 'mule-version)
  20.                      (string-match "[0-9]+\\.[0-9]+"
  21.                            mule-version))
  22.                     (string-to-number (substring
  23.                                mule-version
  24.                                (match-beginning 0)
  25.                                (match-end 0))))
  26.                    (t 2.3))
  27.                 0)
  28.   "What version of mule we are running under.")
  29.  
  30. (defconst mule-retrieval-coding-system
  31.   (case mule-sysdep-version
  32.     (2.3 *euc-japan*)
  33.     (2.4 'coding-system-euc-japan)
  34.     (3.0 'euc-japan)
  35.     (xemacs 'euc-japan)
  36.     (otherwise nil))
  37.   "Default retrieval coding system for packages that use this package.")
  38.  
  39. (defconst mule-no-coding-system
  40.   (case mule-sysdep-version
  41.     (2.3 *noconv*)
  42.     (2.4 'no-conversion)
  43.     (3.0 'no-conversion)
  44.     (xemacs 'no-conversion)
  45.     (otherwise nil))
  46.   "Coding system that means no coding system should be used.")
  47.  
  48. (defun mule-detect-coding-version (st nd)
  49.   (case mule-sysdep-version
  50.     (2.3 (code-detect-region (point-min) (point-max)))
  51.     ((2.4 3.0 xemacs)
  52.      (detect-coding-region (point-min) (point-max)))
  53.     (otherwise nil)))
  54.  
  55. (defun mule-code-convert-region (st nd code)
  56.   (if (and (listp code) (car code))
  57.       (setq code (car code)))
  58.   (case mule-sysdep-version
  59.     (2.3
  60.      (set 'mc-flag t)
  61.      (code-convert-region (point-min) (point-max) code *internal*)
  62.      (set-file-coding-system code))
  63.     (2.4
  64.      (set (make-local-variable 'enable-multibyte-characters) t)
  65.      (if (memq code '(autodetect coding-system-automatic))
  66.      nil
  67.        (decode-coding-region st nd code)
  68.        (set-buffer-file-coding-system code)))
  69.     (3.0
  70.      (set (make-local-variable 'enable-multibyte-characters) t)
  71.      (if (memq code '(autodetect automatic-conversion))
  72.      nil
  73.        (or code (setq code 'automatic-conversion))
  74.        (decode-coding-region st nd code)
  75.        (set-buffer-file-coding-system code)))
  76.     (xemacs
  77.      (if (and (listp code) (not (car code)))
  78.      (progn
  79.        (setq code 'autodetect)
  80.        (condition-case ()
  81.            (get-coding-system 'autodetect)
  82.          (error (setq code 'automatic-conversion)))))
  83.      (decode-coding-region (point-min) (point-max) code)
  84.      (set-file-coding-system code))
  85.     (otherwise
  86.      nil)))
  87.  
  88. (defun mule-inhibit-code-conversion (proc)
  89.   (if (process-buffer proc)
  90.       (save-excursion
  91.     (set-buffer (process-buffer proc))
  92.     (set 'mc-flag nil)
  93.     (set 'enable-multibyte-characters nil)))
  94.   (case mule-sysdep-version
  95.     ((3.0 2.4 2.3)
  96.      (set-process-coding-system proc mule-no-coding-system
  97.                 mule-no-coding-system))
  98.     (xemacs
  99.      (set-process-input-coding-system proc mule-no-coding-system)
  100.      (set-process-input-coding-system proc mule-no-coding-system))))
  101.  
  102. (defun mule-write-region-no-coding-system (st nd file)
  103.   (let ((enable-multibyte-characters t)
  104.     (coding-system-for-write 'no-conversion)
  105.     (file-coding-system mule-no-coding-system)
  106.     (buffer-file-coding-system mule-no-coding-system)
  107.     (mc-flag t))
  108.     (case mule-sysdep-version
  109.       (2.3 (write-region st nd file nil nil nil *noconv*))
  110.       (otherwise
  111.        (write-region st nd file)))))
  112.  
  113. (defun mule-encode-string (str)
  114.   (case mule-sysdep-version
  115.     (2.3
  116.      (code-convert-string str *internal* mule-retrieval-coding-system))
  117.     ((2.4 3.0 xemacs)
  118.      (encode-coding-string str mule-retrieval-coding-system))
  119.     (otherwise
  120.      str)))
  121.  
  122. (defun mule-decode-string (str)
  123.   (and str
  124.        (case mule-sysdep-version
  125.      ((2.4 3.0 xemacs)
  126.       (decode-coding-string str mule-retrieval-coding-system))
  127.      (2.3
  128.       (code-convert-string str *internal* mule-retrieval-coding-system))
  129.      (otherwise
  130.       str))))
  131.  
  132. (defun mule-truncate-string (str len &optional pad)
  133.   "Truncate string STR so that string-width of STR is not greater than LEN.
  134.  If width of the truncated string is less than LEN, and if a character PAD is
  135.  defined, add padding end of it."
  136.   (case mule-sysdep-version
  137.     ((2.4 3.0)
  138.      (let ((cl (string-to-vector str)) (n 0) (sw 0))
  139.        (if (<= (string-width str) len) str
  140.      (while (<= (setq sw (+ (char-width (aref cl n)) sw)) len)
  141.        (setq n (1+ n)))
  142.      (string-match (make-string n ?.) str)
  143.      (setq str (substring str 0 (match-end 0))))
  144.        (if pad (concat str (make-string (- len (string-width str)) pad)) str)))
  145.     (2.3
  146.      (let ((cl (string-to-char-list str)) (n 0) (sw 0))
  147.        (if (<= (string-width str) len) str
  148.      (while (<= (setq sw (+ (char-width (nth n cl)) sw)) len)
  149.        (setq n (1+ n)))
  150.      (string-match (make-string n ?.) str)
  151.      (setq str (substring str 0 (match-end 0))))
  152.        (if pad (concat str (make-string (- len (string-width str)) pad)) str)))
  153.     (otherwise
  154.      (concat (if (> (length str) len) (substring str 0 len) str)
  155.          (if (or (null pad) (> (length str) len))
  156.          ""
  157.            (make-string (- len (length str)) pad))))))
  158.  
  159. (defun mule-find-charset-region (beg end &optional table)
  160.   (case mule-sysdep-version
  161.     (2.3 (code-detect-region beg end))
  162.     ((2.4 3.0) (find-charset-region beg end table))
  163.     (xemacs (charsets-in-region beg end))
  164.     (otherwise '(no-conversion))))
  165.  
  166. (defun mule-coding-system-name (codesys)
  167.   (case mule-sysdep-version
  168.     (3.0 nil)
  169.     (xemacs (coding-system-name codesys))))
  170.  
  171. (defun mule-find-coding-system (sys)
  172.   (case mule-sysdep-version
  173.     ((2.3 2.4) nil)
  174.     (3.0 (if (get sys 'coding-system) sys nil))
  175.     (xemacs (find-coding-system sys))
  176.     (otherwise nil)))
  177.      
  178. (defun mule-make-iso-character (char)
  179.   (if (<= char 127)
  180.       char
  181.     (case mule-sysdep-version
  182.       (2.3 (make-character lc-ltn1 char))
  183.       (2.4 (make-char charset-latin-iso8859-1 char))
  184.       (3.0 (make-char 'latin-iso8859-1 char))
  185.       (xemacs char)
  186.       (otherwise char))))
  187.  
  188. (case mule-sysdep-version
  189.   ((2.3 2.4 3.0 xemacs) nil)
  190.   (otherwise (fset 'string-width 'length)))
  191.  
  192. (and
  193.  (boundp 'MULE)
  194.  (not (featurep 'mule))
  195.  (provide 'mule))
  196.  
  197. (provide 'mule-sysdp)
  198.